open Js_of_ocaml
open Base

class type glue = object
  method onRepaint : (unit -> unit) Js.callback -> unit Js.meth
  method onTick : (unit -> unit) Js.callback -> unit Js.meth
  method onClick : (int -> int -> unit) Js.callback -> unit Js.meth

  method paintClear : unit Js.meth
  method paintRect : int -> int -> int -> int -> Js.js_string Js.t -> unit Js.meth
end

module Make(X : sig
    val app : Ax.Component.t
    val glue : glue Js.t
  end) =
struct
  open X

  (*** time ***)

  let init_time = (new%js Js.date_now)##getTime
  let current_time () =
    let now = (new%js Js.date_now)##getTime in
    Float.(to_int (now - init_time))

  (*** callback registry ***)

  let cbs = ref []
  let send (ev : Ax.React_loop.event) =
    List.iter !cbs ~f:(fun cb -> cb ev)

  module Events_layer = struct
    type callback_id = unit
    let bind_callback f = cbs := f::!cbs
    let unregister = ignore
    let poll_time_ms = current_time
  end

  (*** graphics ***)

  module Graphics_layer = struct
    open Ax
    let clear () =
      glue##paintClear
    let rect {Math.bx;by;bw;bh} color =
      glue##paintRect
        bx by bw bh
        (Color.to_string color |> Js.string)
  end

  (*** set up callbacks ***)

  let () = glue##onRepaint (Js.wrap_callback (fun () -> send Repaint))
  let () = glue##onTick (Js.wrap_callback (fun () -> send Tick))
  let () = glue##onClick (Js.wrap_callback (fun x y -> send (Click {x;y})))

  (*** run the loop ***)

  module Loop = Ax.React_loop.Make(Events_layer)(Graphics_layer)
  let init () = Loop.run app
end

let init ?(export="ocamlMain") app =
  Js.export export
    (fun glue ->
       let module M = Make(struct let app = app let glue = glue end) in
       M.init ())
